home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / src / makedefs.c < prev    next >
Text File  |  1994-01-03  |  58KB  |  2,441 lines
  1. # include "MakeDefs.h"
  2. # include "yyMDefs.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 47 "MakeDefs.puma"
  36.  
  37.  
  38. # include "Idents.h"
  39. # include "StringMe.h"
  40.  
  41. # include "protocol.h"
  42.  
  43. # include "Types.h"
  44. # include "Transfor.h"    /* MakeFuncCall */
  45. # include "ChangeDe.h"  /* MakeObjType, ..., MakeObjSave, MakeObjExternal,
  46.                              StatementFunctions                   */
  47. # include "SetDefs.h"     /* MakeVarDefs, MakeACFDefs, CheckExp,
  48.                              MakeIndexDefs                        */
  49.  
  50. #define WARNINGS_Sem 0  /* 1 : prints warnings */
  51.  
  52.     /*****************************************************
  53.     *                                                    *
  54.     *    Global Variables in Making Definitions          *
  55.     *                                                    *
  56.     *    ProgramCounter : counts PROGRAM_DECL            *
  57.     *                                                    *
  58.     *****************************************************/
  59.  
  60. int ProgramCounter;     /* counter for MAIN programs */
  61.  
  62. tTree Entity, NewEntityDecls;   /* global use for translating an entity */
  63. bool IsParameterEntity;
  64. bool InitValEntity;
  65.  
  66. tTree ReverseDeclList (list, newlist)
  67. tTree list, newlist;
  68. { tTree x1;
  69.  
  70.   if (list == NoTree)
  71.      return (newlist);
  72.    else
  73.      { /* reverse ( tail (list), cons (first(list), newlist)) */
  74.        x1 = list->DECL_LIST.Next;
  75.        list->DECL_LIST.Next = newlist;
  76.        return (ReverseDeclList (x1, list));
  77.      }
  78. } /* ReverseDeclList */
  79.  
  80. /*********************************************************************
  81. *                                                                    *
  82. *    I M P L I C I T   T Y P E S   T A B L E                         *
  83. *                                                                    *
  84. *********************************************************************/
  85.  
  86. tTree impl_table [26];   /* A - Z */
  87.  
  88. tTree impl_dummy, impl_int4, impl_real4;   /* predefined types */
  89.  
  90. int check_impl_char (c)
  91. char c;
  92. { return ( (c >= 'A') && (c <= 'Z') ); }
  93.  
  94. void cset_impl_table (first, last, val)
  95. /* set entries form first to last character */
  96. char first, last;
  97. tTree val;
  98. { char i;
  99.   char m[100];
  100.   if (!check_impl_char (first) || !check_impl_char (last))
  101.     { sprintf (m, "Implicit Declaration: %c - %c not valid\\n",
  102.                   first, last);
  103.       simple_error_protocol (m);
  104.     }
  105.   for (i=first;i<=last;i++)
  106.       impl_table[i-'A'] = val;
  107. }
  108.  
  109. void reset_impl_table ()
  110. /* this is the default for implicit definitions */
  111. {  cset_impl_table ('A','H', impl_real4);
  112.    cset_impl_table ('I','N', impl_int4);
  113.    cset_impl_table ('O','Z', impl_real4);
  114. }
  115.  
  116. void init_impl_table ()
  117. /* these type trees are used global for whole phase */
  118. { impl_real4 = mREAL_TYPE (4);
  119.   impl_int4  = mINTEGER_TYPE (4);
  120.   impl_dummy = mDUMMY_TYPE ();
  121.   reset_impl_table ();
  122. }
  123.  
  124. void set_impl_table (first, last, val)
  125. /* redefine for letters in range [first-last] to val */
  126. tIdent first, last;
  127. tTree val;
  128. { char cf, cl, name[100];
  129.   GetString (first, name);
  130.   cf = name[0];
  131.   GetString (last, name);
  132.   cl = name[0];
  133.   cset_impl_table (cf, cl, val);
  134. }
  135.  
  136. tTree get_impl_table (name)
  137. /* query for implicit type */
  138. tIdent name;
  139. { char c, word[100];
  140.   GetString (name, word);
  141.   c = word[0];
  142.   if (check_impl_char (c))
  143.      return (impl_table[c-'A']);
  144.    else
  145.      return (impl_dummy);
  146. }
  147.  
  148.  
  149.  
  150. static FILE * yyf = stdout;
  151.  
  152. static void yyAbort
  153. # ifdef __cplusplus
  154.  (char * yyFunction)
  155. # else
  156.  (yyFunction) char * yyFunction;
  157. # endif
  158. {
  159.  (void) fprintf (stderr, "Error: module MakeDefs, routine %s failed\n", yyFunction);
  160.  exit (1);
  161. }
  162.  
  163. void MakeDefs ARGS((tTree t));
  164. static void MakeUnitDefs ARGS((tTree t));
  165. static void MakeFormalDefs ARGS((tTree t));
  166. static void MakeDECLDefs ARGS((tTree t));
  167. static void MakeTYPEDefs ARGS((tTree t));
  168. static void DeclareUnits ARGS((tTree t));
  169. static void MakeCommons ARGS((tTree t, tTree CommonDecl));
  170. static void CheckImplicitDecls ARGS((tDefinitions t));
  171. static bool IsDummyType ARGS((tTree t));
  172. static tTree ReplaceDummyType ARGS((tTree t, tTree newval));
  173. static void MakeInterfaceDefs ARGS((tTree t));
  174. static tTree Normal1DECLDefs ARGS((tTree t));
  175. static tTree TranslateCommonDECL ARGS((tTree idlist));
  176. static void TranslateEntityDecl ARGS((tIdent id, int pos, tTree attributes, tTree current_entity));
  177. static void UpdateEntityVal ARGS((tTree decl, tTree newval));
  178. static void UpdateEntityDims ARGS((tTree decl, tTree newdims));
  179. static tTree Normal2DECLDefs ARGS((tTree t));
  180.  
  181. void MakeDefs
  182. # if defined __STDC__ | defined __cplusplus
  183. (register tTree t)
  184. # else
  185. (t)
  186.  register tTree t;
  187. # endif
  188. {
  189.   if (t == NoTree) return;
  190.   if (t->Kind == kCOMP_UNIT) {
  191. # line 175 "MakeDefs.puma"
  192.   {
  193. # line 176 "MakeDefs.puma"
  194.    BeginDefinitions ();
  195. # line 177 "MakeDefs.puma"
  196.    ProgramCounter = 0;
  197. # line 178 "MakeDefs.puma"
  198.    open_protocol ("adaptor.def");
  199. # line 179 "MakeDefs.puma"
  200.    init_impl_table ();
  201. # line 180 "MakeDefs.puma"
  202.    DeclareUnits (t->COMP_UNIT.COMP_ELEMENTS);
  203. # line 181 "MakeDefs.puma"
  204.    MakeDefs (t->COMP_UNIT.COMP_ELEMENTS);
  205. # line 182 "MakeDefs.puma"
  206.    CloseDefinitions ();
  207. # line 183 "MakeDefs.puma"
  208.    close_protocol ();
  209.   }
  210.    return;
  211.  
  212.   }
  213.   if (t->Kind == kDECL_EMPTY) {
  214. # line 186 "MakeDefs.puma"
  215.    return;
  216.  
  217.   }
  218.   if (t->Kind == kDECL_LIST) {
  219. # line 189 "MakeDefs.puma"
  220.   {
  221. # line 190 "MakeDefs.puma"
  222.    MakeUnitDefs (t->DECL_LIST.Elem);
  223. # line 191 "MakeDefs.puma"
  224.    MakeDefs (t->DECL_LIST.Next);
  225.   }
  226.    return;
  227.  
  228.   }
  229. # line 194 "MakeDefs.puma"
  230.   {
  231. # line 195 "MakeDefs.puma"
  232.    printf ("MakeDefs failed\n");
  233. # line 196 "MakeDefs.puma"
  234.    FileUnparse (stdout, t);
  235. # line 197 "MakeDefs.puma"
  236.    WriteTree (stdout, t);
  237. # line 198 "MakeDefs.puma"
  238.    kill_in_protocol ();
  239.   }
  240.    return;
  241.  
  242. ;
  243. }
  244.  
  245. static void MakeUnitDefs
  246. # if defined __STDC__ | defined __cplusplus
  247. (register tTree t)
  248. # else
  249. (t)
  250.  register tTree t;
  251. # endif
  252. {
  253.   if (t == NoTree) return;
  254.   if (t->Kind == kPROGRAM_DECL) {
  255. # line 209 "MakeDefs.puma"
  256.  {
  257.   tDefinitions Scope;
  258.   tDefinitions Obj;
  259.   {
  260. # line 210 "MakeDefs.puma"
  261.  
  262. # line 211 "MakeDefs.puma"
  263.  
  264. # line 212 "MakeDefs.puma"
  265.    set_protocol_unit (t);
  266. # line 213 "MakeDefs.puma"
  267.    NewScope ();
  268. # line 214 "MakeDefs.puma"
  269.    MakeFormalDefs (t->PROGRAM_DECL.FORMALS);
  270. # line 215 "MakeDefs.puma"
  271.    MakeUnitDefs (t->PROGRAM_DECL.PROGRAM_BODY);
  272. # line 216 "MakeDefs.puma"
  273.    Scope = GetCurrentScope ();
  274. # line 217 "MakeDefs.puma"
  275.    CloseScope ();
  276. # line 218 "MakeDefs.puma"
  277.    Obj = GetDeclEntry (t->PROGRAM_DECL.Name, GetUnitEntries ());
  278. # line 219 "MakeDefs.puma"
  279.    Obj->ProcObject.Declarations = Scope;
  280.   }
  281.    return;
  282.  }
  283.  
  284.   }
  285.   if (t->Kind == kPROC_DECL) {
  286. # line 222 "MakeDefs.puma"
  287.  {
  288.   tDefinitions Scope;
  289.   tDefinitions Obj;
  290.   {
  291. # line 223 "MakeDefs.puma"
  292.  
  293. # line 224 "MakeDefs.puma"
  294.  
  295. # line 225 "MakeDefs.puma"
  296.    set_protocol_unit (t);
  297. # line 226 "MakeDefs.puma"
  298.    NewScope ();
  299. # line 227 "MakeDefs.puma"
  300.    MakeFormalDefs (t->PROC_DECL.FORMALS);
  301. # line 228 "MakeDefs.puma"
  302.    MakeUnitDefs (t->PROC_DECL.PROC_BODY);
  303. # line 229 "MakeDefs.puma"
  304.    Scope = GetCurrentScope ();
  305. # line 230 "MakeDefs.puma"
  306.    CloseScope ();
  307. # line 231 "MakeDefs.puma"
  308.    Obj = GetDeclEntry (t->PROC_DECL.Name, GetUnitEntries ());
  309. # line 232 "MakeDefs.puma"
  310.    Obj->ProcObject.Declarations = Scope;
  311.   }
  312.    return;
  313.  }
  314.  
  315.   }
  316.   if (t->Kind == kFUNC_DECL) {
  317. # line 235 "MakeDefs.puma"
  318.  {
  319.   tDefinitions Scope;
  320.   tDefinitions Obj;
  321.   {
  322. # line 236 "MakeDefs.puma"
  323.  
  324. # line 237 "MakeDefs.puma"
  325.  
  326. # line 238 "MakeDefs.puma"
  327.    set_protocol_unit (t);
  328. # line 239 "MakeDefs.puma"
  329.    Obj = GetDeclEntry (t->FUNC_DECL.Name, GetUnitEntries ());
  330. # line 240 "MakeDefs.puma"
  331.    NewScope ();
  332. # line 242 "MakeDefs.puma"
  333.    InsertEntry (Obj);
  334. # line 243 "MakeDefs.puma"
  335.    MakeFormalDefs (t->FUNC_DECL.FORMALS);
  336. # line 244 "MakeDefs.puma"
  337.    MakeUnitDefs (t->FUNC_DECL.FUNC_BODY);
  338. # line 245 "MakeDefs.puma"
  339.    Scope = GetCurrentScope ();
  340. # line 246 "MakeDefs.puma"
  341.    CloseScope ();
  342. # line 247 "MakeDefs.puma"
  343.    Obj->FuncObject.Declarations = Scope;
  344.   }
  345.    return;
  346.  }
  347.  
  348.   }
  349.   if (t->Kind == kBLOCK_DATA_DECL) {
  350. # line 250 "MakeDefs.puma"
  351.  {
  352.   tDefinitions Scope;
  353.   tDefinitions Obj;
  354.   {
  355. # line 251 "MakeDefs.puma"
  356.  
  357. # line 252 "MakeDefs.puma"
  358.  
  359. # line 253 "MakeDefs.puma"
  360.    set_protocol_unit (t);
  361. # line 254 "MakeDefs.puma"
  362.    NewScope ();
  363. # line 255 "MakeDefs.puma"
  364.    MakeUnitDefs (t->BLOCK_DATA_DECL.DATA_BODY);
  365. # line 256 "MakeDefs.puma"
  366.    Scope = GetCurrentScope ();
  367. # line 257 "MakeDefs.puma"
  368.    CloseScope ();
  369. # line 258 "MakeDefs.puma"
  370.    Obj = GetDeclEntry (t->BLOCK_DATA_DECL.Name, GetUnitEntries ());
  371. # line 259 "MakeDefs.puma"
  372.    Obj->BlockObject.Declarations = Scope;
  373.   }
  374.    return;
  375.  }
  376.  
  377.   }
  378.   if (t->Kind == kMODULE_DECL) {
  379. # line 262 "MakeDefs.puma"
  380.   {
  381. # line 263 "MakeDefs.puma"
  382.    tree_error_protocol ("MODULES not supported", t);
  383.   }
  384.    return;
  385.  
  386.   }
  387.   if (t->Kind == kBODY_NODE) {
  388. # line 266 "MakeDefs.puma"
  389.   {
  390. # line 267 "MakeDefs.puma"
  391.    reset_impl_table ();
  392. # line 268 "MakeDefs.puma"
  393.  t->BODY_NODE.DECLS = Normal1DECLDefs (t->BODY_NODE.DECLS);
  394. # line 269 "MakeDefs.puma"
  395.    MakeDECLDefs (t->BODY_NODE.DECLS);
  396. # line 270 "MakeDefs.puma"
  397.  t->BODY_NODE.DECLS = Normal2DECLDefs (t->BODY_NODE.DECLS);
  398. # line 271 "MakeDefs.puma"
  399.    StatementFunctions (t);
  400. # line 272 "MakeDefs.puma"
  401.    MakeACFDefs (t->BODY_NODE.STATS);
  402. # line 273 "MakeDefs.puma"
  403.    CheckImplicitDecls (GetCurrentScope ());
  404.   }
  405.    return;
  406.  
  407.   }
  408. # line 276 "MakeDefs.puma"
  409.   {
  410. # line 277 "MakeDefs.puma"
  411.    printf ("MakeUnitDefs failed\n");
  412. # line 278 "MakeDefs.puma"
  413.    FileUnparse (stdout, t);
  414. # line 279 "MakeDefs.puma"
  415.    WriteTree (stdout, t);
  416. # line 280 "MakeDefs.puma"
  417.    kill_in_protocol ();
  418.   }
  419.    return;
  420.  
  421. ;
  422. }
  423.  
  424. static void MakeFormalDefs
  425. # if defined __STDC__ | defined __cplusplus
  426. (register tTree t)
  427. # else
  428. (t)
  429.  register tTree t;
  430. # endif
  431. {
  432.   if (t == NoTree) return;
  433.   if (t->Kind == kDECL_LIST) {
  434. # line 293 "MakeDefs.puma"
  435.   {
  436. # line 294 "MakeDefs.puma"
  437.    MakeFormalDefs (t->DECL_LIST.Elem);
  438. # line 295 "MakeDefs.puma"
  439.    MakeFormalDefs (t->DECL_LIST.Next);
  440.   }
  441.    return;
  442.  
  443.   }
  444.   if (t->Kind == kVAR_PARAM_DECL) {
  445. # line 298 "MakeDefs.puma"
  446.  {
  447.   tDefinitions Obj;
  448.   {
  449. # line 299 "MakeDefs.puma"
  450.  
  451. # line 300 "MakeDefs.puma"
  452.    Obj = GetLocalDecl (t->VAR_PARAM_DECL.Name);
  453. # line 301 "MakeDefs.puma"
  454.    MakeTYPEDefs (t->VAR_PARAM_DECL.VAL);
  455. # line 302 "MakeDefs.puma"
  456.  if (Obj == NoObject)
  457.        { Obj = mVarObject (t->VAR_PARAM_DECL.Name,
  458.                            mVAR_PARAM_DECL (t->VAR_PARAM_DECL.Name, t->VAR_PARAM_DECL.Pos, t->VAR_PARAM_DECL.VAL),
  459.                            mVarDummy (/* intent */ -1, 0, false),
  460.                            0,
  461.                            mDefaultDistribution (0, 0));
  462.          InsertEntry (Obj);
  463.        }
  464.       else
  465.         tree_error_protocol ("dummy argument declared twice: ", t);
  466.  
  467.   }
  468.    return;
  469.  }
  470.  
  471.   }
  472.   if (t->Kind == kPROC_PARAM_DECL) {
  473. # line 315 "MakeDefs.puma"
  474.   {
  475. # line 316 "MakeDefs.puma"
  476.    tree_error_protocol ("dummy subroutines not handled", t);
  477.   }
  478.    return;
  479.  
  480.   }
  481.   if (t->Kind == kFUNC_PARAM_DECL) {
  482. # line 319 "MakeDefs.puma"
  483.   {
  484. # line 320 "MakeDefs.puma"
  485.    tree_error_protocol ("dummy functions not handled", t);
  486.   }
  487.    return;
  488.  
  489.   }
  490.   if (t->Kind == kRET_PARAM_DECL) {
  491. # line 323 "MakeDefs.puma"
  492.   {
  493. # line 324 "MakeDefs.puma"
  494.    tree_error_protocol ("dummy return parameters not handled", t);
  495.   }
  496.    return;
  497.  
  498.   }
  499.   if (t->Kind == kDECL_EMPTY) {
  500. # line 327 "MakeDefs.puma"
  501.    return;
  502.  
  503.   }
  504. # line 330 "MakeDefs.puma"
  505.   {
  506. # line 331 "MakeDefs.puma"
  507.    printf ("MakeFormalDefs failed\n");
  508. # line 332 "MakeDefs.puma"
  509.    FileUnparse (stdout, t);
  510. # line 333 "MakeDefs.puma"
  511.    WriteTree (stdout, t);
  512. # line 334 "MakeDefs.puma"
  513.    kill_in_protocol ();
  514.   }
  515.    return;
  516.  
  517. ;
  518. }
  519.  
  520. static void MakeDECLDefs
  521. # if defined __STDC__ | defined __cplusplus
  522. (register tTree t)
  523. # else
  524. (t)
  525.  register tTree t;
  526. # endif
  527. {
  528. # line 345 "MakeDefs.puma"
  529.  
  530. tTree newdecl;
  531.  
  532.   if (t == NoTree) return;
  533.  
  534.   switch (t->Kind) {
  535.   case kDECL_LIST:
  536. # line 349 "MakeDefs.puma"
  537.   {
  538. # line 350 "MakeDefs.puma"
  539.    MakeDECLDefs (t->DECL_LIST.Elem);
  540. # line 351 "MakeDefs.puma"
  541.    MakeDECLDefs (t->DECL_LIST.Next);
  542.   }
  543.    return;
  544.  
  545.   case kDECL_EMPTY:
  546. # line 354 "MakeDefs.puma"
  547.    return;
  548.  
  549.   case kVAR_DECL:
  550. # line 365 "MakeDefs.puma"
  551.  {
  552.   tDefinitions Obj;
  553.   {
  554. # line 367 "MakeDefs.puma"
  555.  
  556. # line 369 "MakeDefs.puma"
  557.    MakeTYPEDefs (t->VAR_DECL.VAL);
  558. # line 371 "MakeDefs.puma"
  559.    Obj = GetLocalDecl (t->VAR_DECL.Name);
  560. # line 373 "MakeDefs.puma"
  561.  if (Obj == NoObject)
  562.         { Obj = mVarObject (t->VAR_DECL.Name, mVAR_DECL (t->VAR_DECL.Name, t->VAR_DECL.Pos, t->VAR_DECL.VAL),
  563.                             mVarLocal (0,0), 0,
  564.                             mDefaultDistribution (0,0));
  565.           InsertEntry (Obj);
  566.         }
  567.       else
  568.         {
  569.           MakeObjType (t, Obj);
  570.         }
  571.  
  572.   }
  573.    return;
  574.  }
  575.  
  576.   case kDIMENSION_DECL:
  577. # line 394 "MakeDefs.puma"
  578.  {
  579.   tDefinitions Obj;
  580.   tTree type;
  581.   {
  582. # line 396 "MakeDefs.puma"
  583.  
  584. # line 397 "MakeDefs.puma"
  585.  
  586. # line 399 "MakeDefs.puma"
  587.    MakeTYPEDefs (t->DIMENSION_DECL.INDEXES);
  588. # line 401 "MakeDefs.puma"
  589.    Obj = GetLocalDecl (t->DIMENSION_DECL.Name);
  590. # line 403 "MakeDefs.puma"
  591.  if (Obj == NoObject)
  592.         { type = mARRAY_TYPE (t->DIMENSION_DECL.INDEXES, mDUMMY_TYPE ());
  593.           Obj = mVarObject (t->DIMENSION_DECL.Name, mVAR_DECL(t->DIMENSION_DECL.Name, t->DIMENSION_DECL.Pos, type),
  594.                             mVarLocal (0,0), 0,
  595.                             mDefaultDistribution (0,0));
  596.           InsertEntry (Obj);
  597.         }
  598.       else
  599.         {
  600.           MakeObjDimension (t, Obj);
  601.         }
  602.  
  603.   }
  604.    return;
  605.  }
  606.  
  607.   case kSAVE_DECL:
  608.   if (equaltIdent (t->SAVE_DECL.Name, MakeIdent (" ", 1))) {
  609. # line 423 "MakeDefs.puma"
  610.   {
  611. # line 425 "MakeDefs.puma"
  612.    tree_error_protocol ("General SAVE not handled : ", t);
  613.   }
  614.    return;
  615.  
  616.   }
  617. # line 428 "MakeDefs.puma"
  618.  {
  619.   tDefinitions Obj;
  620.   tTree type;
  621.   {
  622. # line 431 "MakeDefs.puma"
  623.  
  624. # line 432 "MakeDefs.puma"
  625.  
  626. # line 434 "MakeDefs.puma"
  627.    Obj = GetLocalDecl (t->SAVE_DECL.Name);
  628. # line 436 "MakeDefs.puma"
  629.  if (Obj == NoObject)
  630.         { type = mDUMMY_TYPE ();
  631.           Obj  = mVarObject (t->SAVE_DECL.Name, mVAR_DECL (t->SAVE_DECL.Name, t->SAVE_DECL.Pos, type),
  632.                     mVarLocal (1, 0), 0,
  633.                     mDefaultDistribution (0,0)   ) ;
  634.           InsertEntry (Obj);
  635.         }
  636.       else
  637.         MakeObjSave (t, Obj);
  638.  
  639.   }
  640.    return;
  641.  }
  642.  
  643.   case kSEQUENCE_DECL:
  644.   if (equaltIdent (t->SEQUENCE_DECL.Name, MakeIdent (" ", 1))) {
  645. # line 454 "MakeDefs.puma"
  646.   {
  647. # line 456 "MakeDefs.puma"
  648.    tree_error_protocol ("General SEQUENCE not handled : ", t);
  649.   }
  650.    return;
  651.  
  652.   }
  653. # line 459 "MakeDefs.puma"
  654.  {
  655.   tDefinitions Obj;
  656.   {
  657. # line 460 "MakeDefs.puma"
  658.  
  659. # line 461 "MakeDefs.puma"
  660.    Obj = GetDeclEntry (t->SEQUENCE_DECL.Name, GetCommonEntries ());
  661. # line 462 "MakeDefs.puma"
  662.    if (! ((Obj != NoObject))) goto yyL8;
  663.   {
  664. # line 463 "MakeDefs.puma"
  665.    MakeObjSequential (t, Obj);
  666.   }
  667.   }
  668.    return;
  669.  }
  670. yyL8:;
  671.  
  672. # line 466 "MakeDefs.puma"
  673.  {
  674.   tDefinitions Obj;
  675.   {
  676. # line 467 "MakeDefs.puma"
  677.  
  678. # line 468 "MakeDefs.puma"
  679.    Obj = GetLocalDecl (t->SEQUENCE_DECL.Name);
  680. # line 469 "MakeDefs.puma"
  681.    if (! ((Obj != NoObject))) goto yyL9;
  682.   {
  683. # line 470 "MakeDefs.puma"
  684.    tree_error_protocol ("SEQUENCE directive for non COMMON not supported", t);
  685.   }
  686.   }
  687.    return;
  688.  }
  689. yyL9:;
  690.  
  691. # line 473 "MakeDefs.puma"
  692.   {
  693. # line 474 "MakeDefs.puma"
  694.    tree_error_protocol ("SEQUENCE directive for undefined object", t);
  695.   }
  696.    return;
  697.  
  698.   case kNOSEQUENCE_DECL:
  699.   if (equaltIdent (t->NOSEQUENCE_DECL.Name, MakeIdent (" ", 1))) {
  700. # line 483 "MakeDefs.puma"
  701.   {
  702. # line 485 "MakeDefs.puma"
  703.    tree_error_protocol ("General NO SEQUENCE not handled : ", t);
  704.   }
  705.    return;
  706.  
  707.   }
  708. # line 488 "MakeDefs.puma"
  709.  {
  710.   tDefinitions Obj;
  711.   {
  712. # line 489 "MakeDefs.puma"
  713.  
  714. # line 490 "MakeDefs.puma"
  715.    Obj = GetDeclEntry (t->NOSEQUENCE_DECL.Name, GetCommonEntries ());
  716. # line 491 "MakeDefs.puma"
  717.    if (! ((Obj != NoObject))) goto yyL12;
  718.   {
  719. # line 492 "MakeDefs.puma"
  720.    MakeObjNoSequential (t, Obj);
  721.   }
  722.   }
  723.    return;
  724.  }
  725. yyL12:;
  726.  
  727. # line 495 "MakeDefs.puma"
  728.  {
  729.   tDefinitions Obj;
  730.   {
  731. # line 496 "MakeDefs.puma"
  732.  
  733. # line 497 "MakeDefs.puma"
  734.    Obj = GetLocalDecl (t->NOSEQUENCE_DECL.Name);
  735. # line 498 "MakeDefs.puma"
  736.    if (! ((Obj != NoObject))) goto yyL13;
  737.   {
  738. # line 500 "MakeDefs.puma"
  739.    tree_error_protocol ("NO SEQUENCE directive for non COMMON not supported", t);
  740.   }
  741.   }
  742.    return;
  743.  }
  744. yyL13:;
  745.  
  746. # line 503 "MakeDefs.puma"
  747.   {
  748. # line 504 "MakeDefs.puma"
  749.    tree_error_protocol ("NO SEQUENCE directive for undefined object", t);
  750.   }
  751.    return;
  752.  
  753.   case kINTRINSIC_DECL:
  754. # line 513 "MakeDefs.puma"
  755.  {
  756.   tDefinitions Obj;
  757.   {
  758. # line 515 "MakeDefs.puma"
  759.  
  760. # line 516 "MakeDefs.puma"
  761.    Obj = GetDeclEntry (t->INTRINSIC_DECL.Name, GetIntrinsicEntries ());
  762. # line 517 "MakeDefs.puma"
  763.  if (Obj == NoObject)
  764.        tree_error_protocol ("INTRINSIC with this name does not exist : ", t);
  765.       else
  766.        InsertEntry (Obj);
  767.  
  768.   }
  769.    return;
  770.  }
  771.  
  772.   case kINTENT_DECL:
  773. # line 524 "MakeDefs.puma"
  774.  {
  775.   tDefinitions Obj;
  776.   {
  777. # line 526 "MakeDefs.puma"
  778.  
  779. # line 528 "MakeDefs.puma"
  780.    Obj = GetLocalDecl (t->INTENT_DECL.Name);
  781. # line 530 "MakeDefs.puma"
  782.  if (Obj == NoObject)
  783.         tree_error_protocol ("INTENT: no dummy with this name", t);
  784.       else
  785.         MakeObjIntent (Obj, t->INTENT_DECL.intent);
  786.  
  787.   }
  788.    return;
  789.  }
  790.  
  791.   case kOPTIONAL_DECL:
  792. # line 537 "MakeDefs.puma"
  793.  {
  794.   tDefinitions Obj;
  795.   {
  796. # line 539 "MakeDefs.puma"
  797.  
  798. # line 541 "MakeDefs.puma"
  799.    Obj = GetLocalDecl (t->OPTIONAL_DECL.Name);
  800. # line 543 "MakeDefs.puma"
  801.  if (Obj == NoObject)
  802.         tree_error_protocol ("OPTIONAL: no dummy with this name", t);
  803.       else
  804.         MakeObjOptional (Obj);
  805.  
  806.   }
  807.    return;
  808.  }
  809.  
  810.   case kALLOCATABLE_DECL:
  811. # line 550 "MakeDefs.puma"
  812.   {
  813. # line 551 "MakeDefs.puma"
  814.    tree_error_protocol ("allocatable not supported until now", t);
  815.   }
  816.    return;
  817.  
  818.   case kPOINTER_DECL:
  819. # line 554 "MakeDefs.puma"
  820.   {
  821. # line 555 "MakeDefs.puma"
  822.    tree_error_protocol ("pointers not supported until now", t);
  823.   }
  824.    return;
  825.  
  826.   case kTARGET_DECL:
  827. # line 558 "MakeDefs.puma"
  828.   {
  829. # line 559 "MakeDefs.puma"
  830.    tree_error_protocol ("targets not supported until now", t);
  831.   }
  832.    return;
  833.  
  834.   case kPUBLIC_DECL:
  835. # line 562 "MakeDefs.puma"
  836.   {
  837. # line 563 "MakeDefs.puma"
  838.    tree_error_protocol ("public not supported until now", t);
  839.   }
  840.    return;
  841.  
  842.   case kPRIVATE_DECL:
  843. # line 566 "MakeDefs.puma"
  844.   {
  845. # line 567 "MakeDefs.puma"
  846.    tree_error_protocol ("private not supported until now", t);
  847.   }
  848.    return;
  849.  
  850.   case kTYPE_DECL:
  851.   if (t->TYPE_DECL.VAL->Kind == kRECORD_TYPE) {
  852. # line 578 "MakeDefs.puma"
  853.  {
  854.   tDefinitions Obj;
  855.   tDefinitions Scope;
  856.   {
  857. # line 580 "MakeDefs.puma"
  858.  
  859. # line 581 "MakeDefs.puma"
  860.  
  861. # line 583 "MakeDefs.puma"
  862.    Obj = GetLocalDecl (t->TYPE_DECL.Name);
  863. # line 585 "MakeDefs.puma"
  864.  if (Obj == NoObject)
  865.         {
  866.           Obj = mTypeObject (t->TYPE_DECL.Name, t, NoDefinitions);
  867.           NewScope ();
  868.           MakeDECLDefs (t->TYPE_DECL.VAL->RECORD_TYPE.COMPONENTS);
  869.           Scope = GetCurrentScope ();
  870.           CloseScope ();
  871.           Obj->TypeObject.Components = Scope;
  872.           InsertEntry (Obj);
  873.         }
  874.       else
  875.         {
  876.           tree_error_protocol ("type name already in use", t);
  877.         }
  878.  
  879.   }
  880.    return;
  881.  }
  882.  
  883.   }
  884.   break;
  885.   case kTEMPLATE_DECL:
  886. # line 610 "MakeDefs.puma"
  887.  {
  888.   tDefinitions Obj;
  889.   {
  890. # line 612 "MakeDefs.puma"
  891.  
  892. # line 614 "MakeDefs.puma"
  893.    MakeTYPEDefs (t->TEMPLATE_DECL.DIMENSIONS);
  894. # line 616 "MakeDefs.puma"
  895.    Obj = GetLocalDecl (t->TEMPLATE_DECL.Name);
  896. # line 618 "MakeDefs.puma"
  897.  if (Obj == NoObject)
  898.         { Obj = mTemplateObject (t->TEMPLATE_DECL.Name, mTEMPLATE_DECL (t->TEMPLATE_DECL.Name, t->TEMPLATE_DECL.Pos, t->TEMPLATE_DECL.DIMENSIONS),
  899.                                 mDefaultDistribution (0,0) );
  900.           InsertEntry (Obj);
  901.         }
  902.       else
  903.         {
  904.           MakeObjType (t, Obj);
  905.         }
  906.  
  907.   }
  908.    return;
  909.  }
  910.  
  911.   case kPROCESSORS_DECL:
  912. # line 638 "MakeDefs.puma"
  913.  {
  914.   tDefinitions Obj;
  915.   {
  916. # line 640 "MakeDefs.puma"
  917.  
  918. # line 642 "MakeDefs.puma"
  919.    MakeTYPEDefs (t->PROCESSORS_DECL.DIMENSIONS);
  920. # line 644 "MakeDefs.puma"
  921.    Obj = GetLocalDecl (t->PROCESSORS_DECL.Name);
  922. # line 646 "MakeDefs.puma"
  923.  if (Obj == NoObject)
  924.         { Obj = mProcessorsObject (t->PROCESSORS_DECL.Name, t);
  925.           InsertEntry (Obj);
  926.         }
  927.       else
  928.         {
  929.           MakeObjType (t, Obj);
  930.         }
  931.  
  932.   }
  933.    return;
  934.  }
  935.  
  936.   case kALIGN_DECL:
  937. # line 665 "MakeDefs.puma"
  938.  {
  939.   tDefinitions Obj;
  940.   {
  941. # line 667 "MakeDefs.puma"
  942.  
  943. # line 669 "MakeDefs.puma"
  944.    Obj = GetLocalDecl (t->ALIGN_DECL.Name);
  945. # line 671 "MakeDefs.puma"
  946.  if (Obj == NoObject)
  947.         tree_error_protocol ("alignment: name not defined", t);
  948.       else
  949.         MakeObjAlignment (t, Obj);
  950.  
  951.   }
  952.    return;
  953.  }
  954.  
  955.   case kDYNAMIC_DECL:
  956. # line 678 "MakeDefs.puma"
  957.   {
  958. # line 679 "MakeDefs.puma"
  959.    tree_error_protocol ("dynamic declaration is  not supported", t);
  960.   }
  961.    return;
  962.  
  963.   case kPARAMETER_DECL:
  964. # line 690 "MakeDefs.puma"
  965.  {
  966.   tDefinitions Obj;
  967.   tTree type;
  968.   {
  969. # line 692 "MakeDefs.puma"
  970.  
  971. # line 693 "MakeDefs.puma"
  972.  
  973. # line 695 "MakeDefs.puma"
  974.  t->PARAMETER_DECL.VAL = CheckExp (t->PARAMETER_DECL.VAL);
  975. # line 697 "MakeDefs.puma"
  976.    Obj = GetLocalDecl (t->PARAMETER_DECL.Name);
  977. # line 699 "MakeDefs.puma"
  978.  if (Obj == NoObject)
  979.       { type = mDUMMY_TYPE ();
  980.         Obj = mVarObject (t->PARAMETER_DECL.Name, mPARAMETER_DECL (t->PARAMETER_DECL.Name, t->PARAMETER_DECL.Pos, t->PARAMETER_DECL.VAL),
  981.                           mVarConstant (t->PARAMETER_DECL.VAL, type),
  982.                           0,
  983.                           mDefaultDistribution (0, 0));
  984.         InsertEntry (Obj);
  985.       }
  986.      else
  987.       {
  988.         MakeObjParameter (t, Obj);
  989.       }
  990.  
  991.   }
  992.    return;
  993.  }
  994.  
  995.   case kIMPLICIT_DECL:
  996.   if (t->IMPLICIT_DECL.VAL->Kind == kDUMMY_TYPE) {
  997. # line 722 "MakeDefs.puma"
  998.   {
  999. # line 724 "MakeDefs.puma"
  1000.    cset_impl_table ('A', 'Z', t->IMPLICIT_DECL.VAL);
  1001.   }
  1002.    return;
  1003.  
  1004.   }
  1005. # line 727 "MakeDefs.puma"
  1006.   {
  1007. # line 728 "MakeDefs.puma"
  1008.    set_impl_table (t->IMPLICIT_DECL.first, t->IMPLICIT_DECL.last, t->IMPLICIT_DECL.VAL);
  1009.   }
  1010.    return;
  1011.  
  1012.   case kEXTERNAL_DECL:
  1013. # line 740 "MakeDefs.puma"
  1014.  {
  1015.   tDefinitions Obj;
  1016.   tTree Decl;
  1017.   {
  1018. # line 742 "MakeDefs.puma"
  1019.  
  1020. # line 743 "MakeDefs.puma"
  1021.  
  1022. # line 745 "MakeDefs.puma"
  1023.    Obj = GetLocalDecl (t->EXTERNAL_DECL.Name);
  1024. # line 747 "MakeDefs.puma"
  1025.  if (Obj == NoObject)
  1026.        {
  1027.          Obj = GetDeclEntry (t->EXTERNAL_DECL.Name, GetUnitEntries ());
  1028.          if (Obj == NoObject)
  1029.             Obj = GetDeclEntry (t->EXTERNAL_DECL.Name, GetExternalEntries ());
  1030.          if (Obj == NoObject)
  1031.             {
  1032.               tree_protocol ("new external subroutine", t);
  1033.               Decl = mEXT_PROC_DECL (t->EXTERNAL_DECL.Name, t->EXTERNAL_DECL.Pos, mDECL_EMPTY());
  1034.  
  1035.               Obj = mProcObject (t->EXTERNAL_DECL.Name, Decl, 0, mENTRY_EMPTY());
  1036.               InsertExternalEntry (Obj);
  1037.             }
  1038.  
  1039.          InsertEntry (Obj);
  1040.        }
  1041.      else
  1042.        {
  1043.          MakeObjExternal (t, Obj);
  1044.        }
  1045.  
  1046.   }
  1047.    return;
  1048.  }
  1049.  
  1050.   case kINTERFACE_DECL:
  1051.   if (t->INTERFACE_DECL.SPEC->Kind == kNO_GENERIC_SPEC) {
  1052. # line 771 "MakeDefs.puma"
  1053.   {
  1054. # line 772 "MakeDefs.puma"
  1055.    MakeInterfaceDefs (t->INTERFACE_DECL.ITEMS);
  1056.   }
  1057.    return;
  1058.  
  1059.   }
  1060. # line 775 "MakeDefs.puma"
  1061.   {
  1062. # line 776 "MakeDefs.puma"
  1063.    tree_error_protocol ("interface with generic specs not supported", t);
  1064.   }
  1065.    return;
  1066.  
  1067.   case kCOMMON_DECL:
  1068. # line 792 "MakeDefs.puma"
  1069.  {
  1070.   tDefinitions Obj;
  1071.   {
  1072. # line 794 "MakeDefs.puma"
  1073.  
  1074. # line 796 "MakeDefs.puma"
  1075.    Obj = GetDeclEntry (t->COMMON_DECL.Name, GetCommonEntries ());
  1076. # line 798 "MakeDefs.puma"
  1077.  if (Obj == NoObject)
  1078.         { Obj = mCommonObject (t->COMMON_DECL.Name, t, 0, 0, 0, 0);
  1079.           InsertCommonEntry (Obj);
  1080.         }
  1081.       else
  1082.         {
  1083.         }
  1084.  
  1085. # line 813 "MakeDefs.puma"
  1086.    MakeDECLDefs (t->COMMON_DECL.IDS);
  1087. # line 814 "MakeDefs.puma"
  1088.    MakeCommons (t->COMMON_DECL.IDS, t);
  1089.   }
  1090.    return;
  1091.  }
  1092.  
  1093.   case kNAMELIST_DECL:
  1094. # line 817 "MakeDefs.puma"
  1095.  {
  1096.   tDefinitions Obj;
  1097.   {
  1098. # line 819 "MakeDefs.puma"
  1099.  
  1100. # line 821 "MakeDefs.puma"
  1101.    Obj = GetLocalDecl (t->NAMELIST_DECL.Name);
  1102. # line 823 "MakeDefs.puma"
  1103.  if (Obj == NoObject)
  1104.         { Obj = mNameListObject (t->NAMELIST_DECL.Name, t);
  1105.           InsertEntry (Obj);
  1106.         }
  1107.       else
  1108.         {
  1109.           error_protocol ("illegal redefinition");
  1110.           tree_protocol ("NAMELIST Declaration is : ", t);
  1111.         }
  1112.  
  1113. # line 835 "MakeDefs.puma"
  1114.    MakeDECLDefs (t->NAMELIST_DECL.IDS);
  1115.   }
  1116.    return;
  1117.  }
  1118.  
  1119.   case kEQV_DECL:
  1120. # line 838 "MakeDefs.puma"
  1121.   {
  1122. # line 840 "MakeDefs.puma"
  1123.    MakeVarDefs (t->EQV_DECL.VARS);
  1124.   }
  1125.    return;
  1126.  
  1127.   case kDATA_DECL:
  1128. # line 843 "MakeDefs.puma"
  1129.   {
  1130. # line 844 "MakeDefs.puma"
  1131.    MakeVarDefs (t->DATA_DECL.VARS);
  1132. # line 845 "MakeDefs.puma"
  1133.    MakeIndexDefs (t->DATA_DECL.VALS);
  1134.   }
  1135.    return;
  1136.  
  1137.   case kDISTRIBUTE_DECL:
  1138. # line 858 "MakeDefs.puma"
  1139.  {
  1140.   tDefinitions Obj;
  1141.   {
  1142. # line 860 "MakeDefs.puma"
  1143.  
  1144. # line 862 "MakeDefs.puma"
  1145.    Obj = GetLocalDecl (t->DISTRIBUTE_DECL.Name);
  1146. # line 864 "MakeDefs.puma"
  1147.  
  1148.      if (Obj == NoObject)
  1149.         tree_error_protocol ("Layout/Distribution: name not defined:", t);
  1150.       else MakeObjDistribution (t, Obj);
  1151.  
  1152.   }
  1153.    return;
  1154.  }
  1155.  
  1156.   case kUSE_DECL:
  1157. # line 871 "MakeDefs.puma"
  1158.   {
  1159. # line 872 "MakeDefs.puma"
  1160.    tree_error_protocol ("use not handled", t);
  1161.   }
  1162.    return;
  1163.  
  1164.   case kONLY_USE_DECL:
  1165. # line 875 "MakeDefs.puma"
  1166.   {
  1167. # line 876 "MakeDefs.puma"
  1168.    tree_error_protocol ("only use not handled", t);
  1169.   }
  1170.    return;
  1171.  
  1172.   }
  1173.  
  1174. # line 879 "MakeDefs.puma"
  1175.   {
  1176. # line 880 "MakeDefs.puma"
  1177.    printf ("MakeDECLDefs failed\n");
  1178. # line 881 "MakeDefs.puma"
  1179.    FileUnparse (stdout, t);
  1180. # line 882 "MakeDefs.puma"
  1181.    WriteTree (stdout, t);
  1182. # line 883 "MakeDefs.puma"
  1183.    kill_in_protocol ();
  1184.   }
  1185.    return;
  1186.  
  1187. ;
  1188. }
  1189.  
  1190. static void MakeTYPEDefs
  1191. # if defined __STDC__ | defined __cplusplus
  1192. (register tTree t)
  1193. # else
  1194. (t)
  1195.  register tTree t;
  1196. # endif
  1197. {
  1198.   if (t == NoTree) return;
  1199.  
  1200.   switch (t->Kind) {
  1201.   case kARRAY_TYPE:
  1202. # line 894 "MakeDefs.puma"
  1203.   {
  1204. # line 895 "MakeDefs.puma"
  1205.    MakeTYPEDefs (t->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  1206. # line 896 "MakeDefs.puma"
  1207.    MakeTYPEDefs (t->ARRAY_TYPE.ARRAY_COMP_TYPE);
  1208.   }
  1209.    return;
  1210.  
  1211.   case kTYPE_LIST:
  1212. # line 899 "MakeDefs.puma"
  1213.   {
  1214. # line 900 "MakeDefs.puma"
  1215.    MakeTYPEDefs (t->TYPE_LIST.Elem);
  1216. # line 901 "MakeDefs.puma"
  1217.    MakeTYPEDefs (t->TYPE_LIST.Next);
  1218.   }
  1219.    return;
  1220.  
  1221.   case kTYPE_EMPTY:
  1222. # line 904 "MakeDefs.puma"
  1223.    return;
  1224.  
  1225.   case kINDEX_TYPE:
  1226. # line 907 "MakeDefs.puma"
  1227.   {
  1228. # line 908 "MakeDefs.puma"
  1229.  t->INDEX_TYPE.LOWER  = CheckExp (t->INDEX_TYPE.LOWER);
  1230.      t->INDEX_TYPE.UPPER = CheckExp (t->INDEX_TYPE.UPPER);
  1231.  
  1232.   }
  1233.    return;
  1234.  
  1235.   case kDUMMY_TYPE:
  1236. # line 913 "MakeDefs.puma"
  1237.    return;
  1238.  
  1239.   case kCHAR_TYPE:
  1240. # line 914 "MakeDefs.puma"
  1241.    return;
  1242.  
  1243.   case kINTEGER_TYPE:
  1244. # line 916 "MakeDefs.puma"
  1245.    return;
  1246.  
  1247.   case kREAL_TYPE:
  1248. # line 917 "MakeDefs.puma"
  1249.    return;
  1250.  
  1251.   case kCOMPLEX_TYPE:
  1252. # line 918 "MakeDefs.puma"
  1253.    return;
  1254.  
  1255.   case kBOOLEAN_TYPE:
  1256. # line 919 "MakeDefs.puma"
  1257.    return;
  1258.  
  1259.   case kSTRING_TYPE:
  1260. # line 921 "MakeDefs.puma"
  1261.   {
  1262. # line 922 "MakeDefs.puma"
  1263.  t->STRING_TYPE.LENGTH = CheckExp (t->STRING_TYPE.LENGTH);
  1264.   }
  1265.    return;
  1266.  
  1267.   case kDYNAMIC:
  1268. # line 925 "MakeDefs.puma"
  1269.   {
  1270. # line 927 "MakeDefs.puma"
  1271.    t->DYNAMIC.Shape = NoTree;
  1272.   }
  1273.    return;
  1274.  
  1275.   case kTYPE_ID:
  1276. # line 930 "MakeDefs.puma"
  1277.  {
  1278.   tDefinitions Obj;
  1279.   {
  1280. # line 932 "MakeDefs.puma"
  1281.  
  1282. # line 934 "MakeDefs.puma"
  1283.    Obj = GetGlobalDecl (t->TYPE_ID.ID->TYPE_OBJ.Ident);
  1284. # line 938 "MakeDefs.puma"
  1285.  if (Obj == NoObject)
  1286.         tree_error_protocol ("undefined type ", t);
  1287.       else if (Obj->Kind != kTypeObject)
  1288.         tree_error_protocol ("not a derived type", t);
  1289.       else
  1290.         t->TYPE_ID.ID->TYPE_OBJ.Object = Obj;
  1291.  
  1292.   }
  1293.    return;
  1294.  }
  1295.  
  1296.   }
  1297.  
  1298. # line 947 "MakeDefs.puma"
  1299.   {
  1300. # line 948 "MakeDefs.puma"
  1301.    printf ("MakeTYPEDefs failed\n");
  1302. # line 949 "MakeDefs.puma"
  1303.    FileUnparse (stdout, t);
  1304. # line 950 "MakeDefs.puma"
  1305.    WriteTree (stdout, t);
  1306. # line 951 "MakeDefs.puma"
  1307.    kill_in_protocol ();
  1308.   }
  1309.    return;
  1310.  
  1311. ;
  1312. }
  1313.  
  1314. static void DeclareUnits
  1315. # if defined __STDC__ | defined __cplusplus
  1316. (register tTree t)
  1317. # else
  1318. (t)
  1319.  register tTree t;
  1320. # endif
  1321. {
  1322. # line 966 "MakeDefs.puma"
  1323.  
  1324. char s[50], msg[156];
  1325.  
  1326.   if (t == NoTree) return;
  1327.  
  1328.   switch (t->Kind) {
  1329.   case kDECL_LIST:
  1330. # line 970 "MakeDefs.puma"
  1331.   {
  1332. # line 971 "MakeDefs.puma"
  1333.    DeclareUnits (t->DECL_LIST.Elem);
  1334. # line 972 "MakeDefs.puma"
  1335.    DeclareUnits (t->DECL_LIST.Next);
  1336.   }
  1337.    return;
  1338.  
  1339.   case kPROGRAM_DECL:
  1340. # line 975 "MakeDefs.puma"
  1341.   {
  1342. # line 976 "MakeDefs.puma"
  1343.  if (GetDeclEntry (t->PROGRAM_DECL.Name, GetUnitEntries ()) != NoObject)
  1344.         { GetString (t->PROGRAM_DECL.Name, s);
  1345.           sprintf (msg, "PROGRAM %s redeclares other unit\n", s);
  1346.           simple_error_protocol (msg);
  1347.         }
  1348.        else
  1349.           InsertUnitEntry (mProcObject (t->PROGRAM_DECL.Name, t, 0, mENTRY_EMPTY()));
  1350.       ProgramCounter += 1;
  1351.       if (ProgramCounter > 1)
  1352.         { GetString (t->PROGRAM_DECL.Name, s);
  1353.           sprintf (msg, "PROGRAM %s : is %d. main program",
  1354.                    s, ProgramCounter);
  1355.           simple_error_protocol (msg);
  1356.         }
  1357.  
  1358.   }
  1359.    return;
  1360.  
  1361.   case kPROC_DECL:
  1362. # line 993 "MakeDefs.puma"
  1363.   {
  1364. # line 994 "MakeDefs.puma"
  1365.  if (GetDeclEntry (t->PROC_DECL.Name, GetUnitEntries ()) != NoObject)
  1366.         { GetString (t->PROC_DECL.Name, s);
  1367.           sprintf (msg, "SUBROUTINE %s redeclares other unit\n", s);
  1368.           simple_error_protocol (msg);
  1369.         }
  1370.        else
  1371.           InsertUnitEntry (mProcObject (t->PROC_DECL.Name,t, 0, mENTRY_EMPTY()));
  1372.  
  1373.   }
  1374.    return;
  1375.  
  1376.   case kFUNC_DECL:
  1377. # line 1004 "MakeDefs.puma"
  1378.   {
  1379. # line 1005 "MakeDefs.puma"
  1380.  if (GetDeclEntry (t->FUNC_DECL.Name, GetUnitEntries ()) != NoObject)
  1381.         { GetString (t->FUNC_DECL.Name, s);
  1382.           sprintf (msg, "FUNCTION %s redeclares other unit\n", s);
  1383.           simple_error_protocol (msg);
  1384.         }
  1385.        else
  1386.           InsertUnitEntry (mFuncObject (t->FUNC_DECL.Name, t, 0, mENTRY_EMPTY ()));
  1387.  
  1388.   }
  1389.    return;
  1390.  
  1391.   case kMODULE_DECL:
  1392. # line 1015 "MakeDefs.puma"
  1393.   {
  1394. # line 1016 "MakeDefs.puma"
  1395.  if (GetDeclEntry (t->MODULE_DECL.Name, GetUnitEntries ()) != NoObject)
  1396.         { GetString (t->MODULE_DECL.Name, s);
  1397.           sprintf (msg, "MODULE %s redeclares other unit\n", s);
  1398.           simple_error_protocol (msg);
  1399.         }
  1400.        else
  1401.           InsertUnitEntry (mModuleObject (t->MODULE_DECL.Name, t, 0, mENTRY_EMPTY ()));
  1402.  
  1403.   }
  1404.    return;
  1405.  
  1406.   case kBLOCK_DATA_DECL:
  1407. # line 1026 "MakeDefs.puma"
  1408.   {
  1409. # line 1027 "MakeDefs.puma"
  1410.  if (GetDeclEntry (t->BLOCK_DATA_DECL.Name, GetUnitEntries ()) != NoObject)
  1411.         { GetString (t->BLOCK_DATA_DECL.Name, s);
  1412.           sprintf (msg, "BLOCK DATA %s redeclares other unit\n", s);
  1413.           simple_error_protocol (msg);
  1414.         }
  1415.        else
  1416.           InsertUnitEntry (mBlockObject (t->BLOCK_DATA_DECL.Name, t, mENTRY_EMPTY ()));
  1417.  
  1418.   }
  1419.    return;
  1420.  
  1421.   case kDECL_EMPTY:
  1422. # line 1037 "MakeDefs.puma"
  1423.    return;
  1424.  
  1425.   }
  1426.  
  1427. # line 1040 "MakeDefs.puma"
  1428.   {
  1429. # line 1041 "MakeDefs.puma"
  1430.    printf ("Unknown Tree in DeclareUnits\n");
  1431. # line 1042 "MakeDefs.puma"
  1432.    FileUnparse (stdout, t);
  1433. # line 1043 "MakeDefs.puma"
  1434.    WriteTree (stdout, t);
  1435.   }
  1436.    return;
  1437.  
  1438. ;
  1439. }
  1440.  
  1441. static void MakeCommons
  1442. # if defined __STDC__ | defined __cplusplus
  1443. (register tTree t, register tTree CommonDecl)
  1444. # else
  1445. (t, CommonDecl)
  1446.  register tTree t;
  1447.  register tTree CommonDecl;
  1448. # endif
  1449. {
  1450. # line 1054 "MakeDefs.puma"
  1451.  
  1452. char string[256];
  1453. tObject Obj;
  1454.  
  1455.   if (t == NoTree) return;
  1456.   if (CommonDecl == NoTree) return;
  1457.   if (t->Kind == kDECL_EMPTY) {
  1458. # line 1059 "MakeDefs.puma"
  1459.    return;
  1460.  
  1461.   }
  1462.   if (t->Kind == kDECL_LIST) {
  1463. # line 1062 "MakeDefs.puma"
  1464.   {
  1465. # line 1063 "MakeDefs.puma"
  1466.    MakeCommons (t->DECL_LIST.Elem, CommonDecl);
  1467. # line 1064 "MakeDefs.puma"
  1468.    MakeCommons (t->DECL_LIST.Next, CommonDecl);
  1469.   }
  1470.    return;
  1471.  
  1472.   }
  1473.   if (t->Kind == kVAR_DECL) {
  1474. # line 1067 "MakeDefs.puma"
  1475.   {
  1476. # line 1068 "MakeDefs.puma"
  1477.    Obj = GetLocalDecl (t->VAR_DECL.Name);
  1478. # line 1069 "MakeDefs.puma"
  1479.    GetString (t->VAR_DECL.Name, string);
  1480. # line 1070 "MakeDefs.puma"
  1481.  if (Obj == NoObject)
  1482.             printf ("%s in Common Block not declared\n", string);
  1483. # line 1072 "MakeDefs.puma"
  1484.  if (Obj->Kind != kVarObject)
  1485.             printf ("%s in Common Block not a Variable\n", string);
  1486. # line 1074 "MakeDefs.puma"
  1487.    MakeObjCommon (CommonDecl, Obj);
  1488.   }
  1489.    return;
  1490.  
  1491.   }
  1492.   if (CommonDecl->Kind == kCOMMON_DECL) {
  1493. # line 1077 "MakeDefs.puma"
  1494.   {
  1495. # line 1078 "MakeDefs.puma"
  1496.    GetString (CommonDecl->COMMON_DECL.Name, string);
  1497. # line 1079 "MakeDefs.puma"
  1498.    printf ("Illegal Declaration in Common Block %s \n", string);
  1499.   }
  1500.    return;
  1501.  
  1502.   }
  1503. ;
  1504. }
  1505.  
  1506. static void CheckImplicitDecls
  1507. # if defined __STDC__ | defined __cplusplus
  1508. (register tDefinitions t)
  1509. # else
  1510. (t)
  1511.  register tDefinitions t;
  1512. # endif
  1513. {
  1514. # line 1090 "MakeDefs.puma"
  1515.  
  1516. char string[50], msg[100];
  1517.  
  1518.   if (t == NoDefinitions) return;
  1519.   if (t->Kind == kENTRY_LIST) {
  1520. # line 1094 "MakeDefs.puma"
  1521.   {
  1522. # line 1095 "MakeDefs.puma"
  1523.    CheckImplicitDecls (t->ENTRY_LIST.Elem);
  1524. # line 1096 "MakeDefs.puma"
  1525.    CheckImplicitDecls (t->ENTRY_LIST.Next);
  1526.   }
  1527.    return;
  1528.  
  1529.   }
  1530.   if (t->Kind == kENTRY_EMPTY) {
  1531. # line 1099 "MakeDefs.puma"
  1532.    return;
  1533.  
  1534.   }
  1535.   if (t->Kind == kVarObject) {
  1536.   if (t->VarObject.decl->Kind == kVAR_DECL) {
  1537. # line 1102 "MakeDefs.puma"
  1538.   {
  1539. # line 1103 "MakeDefs.puma"
  1540.  if (IsDummyType (t->VarObject.decl->VAR_DECL.VAL))
  1541.            { t->VarObject.decl->VAR_DECL.VAL = ReplaceDummyType (t->VarObject.decl->VAR_DECL.VAL, get_impl_table (t->VarObject.ident));
  1542.              GetString (t->VarObject.ident, string);
  1543.              sprintf (msg, "%s is implicitly defined, type = ",string);
  1544.              tree_warning_protocol (msg, t->VarObject.decl->VAR_DECL.VAL);
  1545.            }
  1546.  
  1547.   }
  1548.    return;
  1549.  
  1550.   }
  1551.   if (t->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  1552. # line 1112 "MakeDefs.puma"
  1553.   {
  1554. # line 1113 "MakeDefs.puma"
  1555.  if (IsDummyType (t->VarObject.decl->VAR_PARAM_DECL.VAL))
  1556.            { t->VarObject.decl->VAR_PARAM_DECL.VAL = ReplaceDummyType (t->VarObject.decl->VAR_PARAM_DECL.VAL, get_impl_table (t->VarObject.ident));
  1557.              GetString (t->VarObject.ident, string);
  1558.              sprintf (msg, "%s is implicitly defined, type = ",string);
  1559.              tree_warning_protocol (msg, t->VarObject.decl->VAR_PARAM_DECL.VAL);
  1560.            }
  1561.  
  1562.   }
  1563.    return;
  1564.  
  1565.   }
  1566.   if (t->VarObject.Kind->Kind == kVarConstant) {
  1567. # line 1122 "MakeDefs.puma"
  1568.   {
  1569. # line 1123 "MakeDefs.puma"
  1570.  if (IsDummyType (t->VarObject.Kind->VarConstant.Type))
  1571.            { t->VarObject.Kind->VarConstant.Type = ReplaceDummyType (t->VarObject.Kind->VarConstant.Type, get_impl_table (t->VarObject.ident));
  1572.              GetString (t->VarObject.ident, string);
  1573.              sprintf (msg, "%s is implicitly defined, type = ",string);
  1574.              tree_warning_protocol (msg, t->VarObject.Kind->VarConstant.Type);
  1575.            }
  1576.  
  1577.   }
  1578.    return;
  1579.  
  1580.   }
  1581.   }
  1582.   if (t->Kind == kFuncObject) {
  1583.   if (t->FuncObject.decl->Kind == kFUNC_DECL) {
  1584. # line 1132 "MakeDefs.puma"
  1585.   {
  1586. # line 1134 "MakeDefs.puma"
  1587.  if (IsDummyType (t->FuncObject.decl->FUNC_DECL.RESULT_TYPE))
  1588.            { t->FuncObject.decl->FUNC_DECL.RESULT_TYPE = ReplaceDummyType (t->FuncObject.decl->FUNC_DECL.RESULT_TYPE, get_impl_table (t->FuncObject.ident));
  1589.              GetString (t->FuncObject.ident, string);
  1590.              sprintf (msg, "%s is implicitly defined, type = ",string);
  1591.              tree_warning_protocol (msg, t->FuncObject.decl->FUNC_DECL.RESULT_TYPE);
  1592.            }
  1593.  
  1594.   }
  1595.    return;
  1596.  
  1597.   }
  1598.   if (t->FuncObject.decl->Kind == kSTMT_FUNC_DECL) {
  1599. # line 1143 "MakeDefs.puma"
  1600.   {
  1601. # line 1144 "MakeDefs.puma"
  1602.  if (IsDummyType (t->FuncObject.decl->STMT_FUNC_DECL.RESULT_TYPE))
  1603.            { t->FuncObject.decl->STMT_FUNC_DECL.RESULT_TYPE = ReplaceDummyType (t->FuncObject.decl->STMT_FUNC_DECL.RESULT_TYPE, get_impl_table (t->FuncObject.ident));
  1604.              GetString (t->FuncObject.ident, string);
  1605.              sprintf (msg, "%s is implicitly defined, type = ",string);
  1606.              tree_warning_protocol (msg, t->FuncObject.decl->STMT_FUNC_DECL.RESULT_TYPE);
  1607.            }
  1608.  
  1609.   }
  1610.    return;
  1611.  
  1612.   }
  1613.   if (t->FuncObject.decl->Kind == kEXT_FUNC_DECL) {
  1614. # line 1153 "MakeDefs.puma"
  1615.   {
  1616. # line 1154 "MakeDefs.puma"
  1617.  if (IsDummyType (t->FuncObject.decl->EXT_FUNC_DECL.RESULT_TYPE))
  1618.            { t->FuncObject.decl->EXT_FUNC_DECL.RESULT_TYPE = ReplaceDummyType (t->FuncObject.decl->EXT_FUNC_DECL.RESULT_TYPE, get_impl_table (t->FuncObject.ident));
  1619.              GetString (t->FuncObject.ident, string);
  1620.              sprintf (msg, "%s is implicitly defined, type = ",string);
  1621.              tree_warning_protocol (msg, t->FuncObject.decl->EXT_FUNC_DECL.RESULT_TYPE);
  1622.            }
  1623.  
  1624.   }
  1625.    return;
  1626.  
  1627.   }
  1628.   }
  1629. ;
  1630. }
  1631.  
  1632. static bool IsDummyType
  1633. # if defined __STDC__ | defined __cplusplus
  1634. (register tTree t)
  1635. # else
  1636. (t)
  1637.  register tTree t;
  1638. # endif
  1639. {
  1640.   if (t == NoTree) return false;
  1641.   if (t->Kind == kDUMMY_TYPE) {
  1642. # line 1171 "MakeDefs.puma"
  1643.    return true;
  1644.  
  1645.   }
  1646.   if (t->Kind == kARRAY_TYPE) {
  1647.   if (t->ARRAY_TYPE.ARRAY_COMP_TYPE->Kind == kDUMMY_TYPE) {
  1648. # line 1173 "MakeDefs.puma"
  1649.    return true;
  1650.  
  1651.   }
  1652.   }
  1653.   return false;
  1654. }
  1655.  
  1656. static tTree ReplaceDummyType
  1657. # if defined __STDC__ | defined __cplusplus
  1658. (register tTree t, register tTree newval)
  1659. # else
  1660. (t, newval)
  1661.  register tTree t;
  1662.  register tTree newval;
  1663. # endif
  1664. {
  1665.   if (t->Kind == kDUMMY_TYPE) {
  1666. # line 1183 "MakeDefs.puma"
  1667.    return newval;
  1668.  
  1669.   }
  1670.   if (t->Kind == kARRAY_TYPE) {
  1671.   if (t->ARRAY_TYPE.ARRAY_COMP_TYPE->Kind == kDUMMY_TYPE) {
  1672. # line 1187 "MakeDefs.puma"
  1673.    return mARRAY_TYPE (t->ARRAY_TYPE.ARRAY_INDEX_TYPES, newval);
  1674.  
  1675.   }
  1676.   }
  1677. # line 1191 "MakeDefs.puma"
  1678.    return t;
  1679.  
  1680. }
  1681.  
  1682. static void MakeInterfaceDefs
  1683. # if defined __STDC__ | defined __cplusplus
  1684. (register tTree t)
  1685. # else
  1686. (t)
  1687.  register tTree t;
  1688. # endif
  1689. {
  1690. # line 1203 "MakeDefs.puma"
  1691.  
  1692. char s[50], msg[156];
  1693.  
  1694.   if (t == NoTree) return;
  1695.  
  1696.   switch (t->Kind) {
  1697.   case kDECL_LIST:
  1698. # line 1207 "MakeDefs.puma"
  1699.   {
  1700. # line 1208 "MakeDefs.puma"
  1701.    MakeInterfaceDefs (t->DECL_LIST.Elem);
  1702. # line 1209 "MakeDefs.puma"
  1703.    MakeInterfaceDefs (t->DECL_LIST.Next);
  1704.   }
  1705.    return;
  1706.  
  1707.   case kDECL_EMPTY:
  1708. # line 1212 "MakeDefs.puma"
  1709.    return;
  1710.  
  1711.   case kPROGRAM_DECL:
  1712. # line 1215 "MakeDefs.puma"
  1713.   {
  1714. # line 1216 "MakeDefs.puma"
  1715.    tree_error_protocol ("main program in interface not allowed", t);
  1716.   }
  1717.    return;
  1718.  
  1719.   case kPROC_DECL:
  1720. # line 1219 "MakeDefs.puma"
  1721.  {
  1722.   tDefinitions Scope;
  1723.   tDefinitions Obj;
  1724.   {
  1725. # line 1221 "MakeDefs.puma"
  1726.  
  1727. # line 1222 "MakeDefs.puma"
  1728.  
  1729. # line 1224 "MakeDefs.puma"
  1730.  if (GetLocalDecl (t->PROC_DECL.Name) != NoObject)
  1731.        { GetString (t->PROC_DECL.Name, s);
  1732.          sprintf (msg, "INTERFACE SUBROUTINE %s redeclares something\n", s);
  1733.          simple_error_protocol (msg);
  1734.        }
  1735.       else
  1736.        { Obj = mProcObject (t->PROC_DECL.Name,t, 0, mENTRY_EMPTY());
  1737.          InsertEntry (Obj);
  1738.          NewScope ();
  1739.          InsertEntry (Obj);
  1740.  
  1741.          MakeFormalDefs (t->PROC_DECL.FORMALS);
  1742.          MakeInterfaceDefs (t->PROC_DECL.PROC_BODY);
  1743.          Scope = GetCurrentScope ();
  1744.          CloseScope ();
  1745.          Obj->FuncObject.Declarations = Scope;
  1746.        }
  1747.  
  1748.   }
  1749.    return;
  1750.  }
  1751.  
  1752.   case kFUNC_DECL:
  1753. # line 1244 "MakeDefs.puma"
  1754.  {
  1755.   tDefinitions Scope;
  1756.   tDefinitions Obj;
  1757.   {
  1758. # line 1246 "MakeDefs.puma"
  1759.  
  1760. # line 1247 "MakeDefs.puma"
  1761.  
  1762. # line 1249 "MakeDefs.puma"
  1763.  if (GetLocalDecl (t->FUNC_DECL.Name) != NoObject)
  1764.        { GetString (t->FUNC_DECL.Name, s);
  1765.          sprintf (msg, "INTERFACE FUNCTION %s redeclares something\n", s);
  1766.          simple_error_protocol (msg);
  1767.        }
  1768.       else
  1769.        { Obj = mFuncObject (t->FUNC_DECL.Name, t, 0, mENTRY_EMPTY());
  1770.          InsertEntry (Obj);
  1771.          NewScope ();
  1772.          InsertEntry (Obj);
  1773.  
  1774.          MakeFormalDefs (t->FUNC_DECL.FORMALS);
  1775.          MakeInterfaceDefs (t->FUNC_DECL.FUNC_BODY);
  1776.          Scope = GetCurrentScope ();
  1777.          CloseScope ();
  1778.          Obj->FuncObject.Declarations = Scope;
  1779.        }
  1780.  
  1781.   }
  1782.    return;
  1783.  }
  1784.  
  1785.   case kBLOCK_DATA_DECL:
  1786. # line 1269 "MakeDefs.puma"
  1787.   {
  1788. # line 1270 "MakeDefs.puma"
  1789.    tree_error_protocol ("block data in interface not allowed", t);
  1790.   }
  1791.    return;
  1792.  
  1793.   case kMODULE_DECL:
  1794. # line 1273 "MakeDefs.puma"
  1795.   {
  1796. # line 1274 "MakeDefs.puma"
  1797.    tree_error_protocol ("modules in interface not allowed", t);
  1798.   }
  1799.    return;
  1800.  
  1801.   case kBODY_NODE:
  1802.   if (t->BODY_NODE.STATS->Kind == kACF_EMPTY) {
  1803.   if (t->BODY_NODE.INTERNALS->Kind == kDECL_EMPTY) {
  1804. # line 1277 "MakeDefs.puma"
  1805.   {
  1806. # line 1278 "MakeDefs.puma"
  1807.    reset_impl_table ();
  1808. # line 1279 "MakeDefs.puma"
  1809.  t->BODY_NODE.DECLS = Normal1DECLDefs (t->BODY_NODE.DECLS);
  1810. # line 1280 "MakeDefs.puma"
  1811.    MakeDECLDefs (t->BODY_NODE.DECLS);
  1812. # line 1281 "MakeDefs.puma"
  1813.  t->BODY_NODE.DECLS = Normal2DECLDefs (t->BODY_NODE.DECLS);
  1814. # line 1282 "MakeDefs.puma"
  1815.    CheckImplicitDecls (GetCurrentScope ());
  1816.   }
  1817.    return;
  1818.  
  1819.   }
  1820.   }
  1821.   if (t->BODY_NODE.INTERNALS->Kind == kDECL_EMPTY) {
  1822. # line 1285 "MakeDefs.puma"
  1823.   {
  1824. # line 1286 "MakeDefs.puma"
  1825.    tree_error_protocol ("statements in interface not allowed", t);
  1826.   }
  1827.    return;
  1828.  
  1829.   }
  1830. # line 1289 "MakeDefs.puma"
  1831.   {
  1832. # line 1290 "MakeDefs.puma"
  1833.    tree_error_protocol ("internal units in interface not allowed", t);
  1834.   }
  1835.    return;
  1836.  
  1837.   }
  1838.  
  1839. # line 1293 "MakeDefs.puma"
  1840.   {
  1841. # line 1294 "MakeDefs.puma"
  1842.    printf ("MakeInterfaceDefs failed\n");
  1843. # line 1295 "MakeDefs.puma"
  1844.    FileUnparse (stdout, t);
  1845. # line 1296 "MakeDefs.puma"
  1846.    WriteTree (stdout, t);
  1847. # line 1297 "MakeDefs.puma"
  1848.    kill_in_protocol ();
  1849.   }
  1850.    return;
  1851.  
  1852. ;
  1853. }
  1854.  
  1855. static tTree Normal1DECLDefs
  1856. # if defined __STDC__ | defined __cplusplus
  1857. (register tTree t)
  1858. # else
  1859. (t)
  1860.  register tTree t;
  1861. # endif
  1862. {
  1863. # line 1321 "MakeDefs.puma"
  1864.  
  1865. tTree newdecl;
  1866.  
  1867.   if (t->Kind == kDECL_LIST) {
  1868. # line 1325 "MakeDefs.puma"
  1869.   {
  1870. # line 1326 "MakeDefs.puma"
  1871.  newdecl = Normal1DECLDefs (t->DECL_LIST.Elem);
  1872.      t->DECL_LIST.Next    = Normal1DECLDefs (t->DECL_LIST.Next);
  1873.      newdecl = ReplaceDECL (t, newdecl, t->DECL_LIST.Next);
  1874.  
  1875.   }
  1876.    return newdecl;
  1877.  
  1878.   }
  1879.   if (t->Kind == kDECL_EMPTY) {
  1880. # line 1333 "MakeDefs.puma"
  1881.    return t;
  1882.  
  1883.   }
  1884.   if (t->Kind == kENTITY_DECL) {
  1885. # line 1345 "MakeDefs.puma"
  1886.   {
  1887. # line 1347 "MakeDefs.puma"
  1888.    Entity = NoTree;
  1889. # line 1348 "MakeDefs.puma"
  1890.    NewEntityDecls = NoTree;
  1891. # line 1349 "MakeDefs.puma"
  1892.    IsParameterEntity = false;
  1893. # line 1350 "MakeDefs.puma"
  1894.    InitValEntity = false;
  1895. # line 1352 "MakeDefs.puma"
  1896.    TranslateEntityDecl (t->ENTITY_DECL.Name, t->ENTITY_DECL.Pos, t->ENTITY_DECL.ATTRIBUTES, t);
  1897.   }
  1898.    return NewEntityDecls;
  1899.  
  1900.   }
  1901.   if (t->Kind == kCOMMON_DECL) {
  1902. # line 1357 "MakeDefs.puma"
  1903.   {
  1904. # line 1361 "MakeDefs.puma"
  1905.  newdecl = TranslateCommonDECL (t->COMMON_DECL.IDS);
  1906.      if (newdecl == NoTree)
  1907.         newdecl = t;
  1908.       else
  1909.         newdecl = mDECL_LIST (t, newdecl);
  1910.  
  1911.   }
  1912.    return newdecl;
  1913.  
  1914.   }
  1915. # line 1372 "MakeDefs.puma"
  1916.    return t;
  1917.  
  1918. }
  1919.  
  1920. static tTree TranslateCommonDECL
  1921. # if defined __STDC__ | defined __cplusplus
  1922. (register tTree idlist)
  1923. # else
  1924. (idlist)
  1925.  register tTree idlist;
  1926. # endif
  1927. {
  1928. # line 1390 "MakeDefs.puma"
  1929.  
  1930. tTree newdecl;
  1931.  
  1932.   if (idlist->Kind == kDECL_LIST) {
  1933. # line 1394 "MakeDefs.puma"
  1934.   {
  1935. # line 1395 "MakeDefs.puma"
  1936.  newdecl = TranslateCommonDECL (idlist->DECL_LIST.Elem);
  1937.      if (newdecl == NoTree)
  1938.         newdecl = TranslateCommonDECL (idlist->DECL_LIST.Next);
  1939.       else
  1940.         newdecl = mDECL_LIST (newdecl, TranslateCommonDECL (idlist->DECL_LIST.Next));
  1941.  
  1942.   }
  1943.    return newdecl;
  1944.  
  1945.   }
  1946.   if (idlist->Kind == kDECL_EMPTY) {
  1947. # line 1404 "MakeDefs.puma"
  1948.    return NoTree;
  1949.  
  1950.   }
  1951.   if (idlist->Kind == kVAR_DECL) {
  1952.   if (idlist->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  1953. # line 1408 "MakeDefs.puma"
  1954.   {
  1955. # line 1409 "MakeDefs.puma"
  1956.  newdecl = mDIMENSION_DECL (idlist->VAR_DECL.Name, idlist->VAR_DECL.Pos, idlist->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  1957.      idlist->VAR_DECL.VAL = idlist->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_COMP_TYPE;
  1958.  
  1959.   }
  1960.    return newdecl;
  1961.  
  1962.   }
  1963. # line 1417 "MakeDefs.puma"
  1964.    return NoTree;
  1965.  
  1966.   }
  1967.  yyAbort ("TranslateCommonDECL");
  1968. }
  1969.  
  1970. static void TranslateEntityDecl
  1971. # if defined __STDC__ | defined __cplusplus
  1972. (register tIdent id, register int pos, register tTree attributes, register tTree current_entity)
  1973. # else
  1974. (id, pos, attributes, current_entity)
  1975.  register tIdent id;
  1976.  register int pos;
  1977.  register tTree attributes;
  1978.  register tTree current_entity;
  1979. # endif
  1980. {
  1981. # line 1432 "MakeDefs.puma"
  1982.  
  1983. tTree newdecl;
  1984.  
  1985.   if (attributes == NoTree) return;
  1986.   if (current_entity == NoTree) return;
  1987.   if (attributes->Kind == kDECL_EMPTY) {
  1988. # line 1438 "MakeDefs.puma"
  1989.   {
  1990. # line 1440 "MakeDefs.puma"
  1991.  if (IsParameterEntity && (!InitValEntity))
  1992.        tree_error_protocol ("Missing initial value for PARAMETER",
  1993.                              current_entity);
  1994.  
  1995.  
  1996.  
  1997.     NewEntityDecls = ReverseDeclList (NewEntityDecls, NoTree);
  1998.  
  1999.  
  2000.  
  2001.     if (Entity != NoTree)
  2002.        NewEntityDecls = mDECL_LIST (Entity, NewEntityDecls);
  2003.  
  2004.  
  2005.   }
  2006.    return;
  2007.  
  2008.   }
  2009.   if (attributes->Kind == kDECL_LIST) {
  2010.  
  2011.   switch (attributes->DECL_LIST.Elem->Kind) {
  2012.   case kTYPESPEC_DECL:
  2013. # line 1456 "MakeDefs.puma"
  2014.   {
  2015. # line 1457 "MakeDefs.puma"
  2016.  if (Entity == NoTree)
  2017.       Entity = mVAR_DECL (id, pos, attributes->DECL_LIST.Elem->TYPESPEC_DECL.VAL);
  2018.      else
  2019.       UpdateEntityVal (Entity, attributes->DECL_LIST.Elem->TYPESPEC_DECL.VAL);
  2020.  
  2021. # line 1462 "MakeDefs.puma"
  2022.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2023.   }
  2024.    return;
  2025.  
  2026.   case kDIMENSION_DECL:
  2027. # line 1465 "MakeDefs.puma"
  2028.   {
  2029. # line 1466 "MakeDefs.puma"
  2030.  if (Entity == NoTree)
  2031.       Entity = mVAR_DECL (id, pos, mARRAY_TYPE (attributes->DECL_LIST.Elem->DIMENSION_DECL.INDEXES, mDUMMY_TYPE()));
  2032.      else
  2033.       UpdateEntityDims (Entity, attributes->DECL_LIST.Elem->DIMENSION_DECL.INDEXES);
  2034.  
  2035. # line 1471 "MakeDefs.puma"
  2036.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2037.   }
  2038.    return;
  2039.  
  2040.   case kINIT_DATA_DECL:
  2041. # line 1474 "MakeDefs.puma"
  2042.   {
  2043. # line 1475 "MakeDefs.puma"
  2044.   InitValEntity = true;
  2045.      if (IsParameterEntity)
  2046.        { newdecl = mPARAMETER_DECL (id, pos, attributes->DECL_LIST.Elem->INIT_DATA_DECL.VAL);
  2047.          NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2048.        }
  2049.       else
  2050.  
  2051.        tree_warning_protocol ("Init Val, no Parameter", current_entity);
  2052.  
  2053. # line 1484 "MakeDefs.puma"
  2054.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2055.   }
  2056.    return;
  2057.  
  2058.   case kSAVE_DECL:
  2059. # line 1487 "MakeDefs.puma"
  2060.   {
  2061. # line 1488 "MakeDefs.puma"
  2062.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->SAVE_DECL.Name = id; attributes->DECL_LIST.Elem->SAVE_DECL.Pos = pos;
  2063.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2064.  
  2065. # line 1491 "MakeDefs.puma"
  2066.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2067.   }
  2068.    return;
  2069.  
  2070.   case kEXTERNAL_DECL:
  2071. # line 1494 "MakeDefs.puma"
  2072.   {
  2073. # line 1495 "MakeDefs.puma"
  2074.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->EXTERNAL_DECL.Name = id; attributes->DECL_LIST.Elem->EXTERNAL_DECL.Pos = pos;
  2075.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2076.  
  2077. # line 1498 "MakeDefs.puma"
  2078.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2079.   }
  2080.    return;
  2081.  
  2082.   case kINTRINSIC_DECL:
  2083. # line 1501 "MakeDefs.puma"
  2084.   {
  2085. # line 1502 "MakeDefs.puma"
  2086.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->INTRINSIC_DECL.Name = id; attributes->DECL_LIST.Elem->INTRINSIC_DECL.Pos = pos;
  2087.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2088.  
  2089. # line 1505 "MakeDefs.puma"
  2090.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2091.   }
  2092.    return;
  2093.  
  2094.   case kINTENT_DECL:
  2095. # line 1508 "MakeDefs.puma"
  2096.   {
  2097. # line 1509 "MakeDefs.puma"
  2098.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->INTENT_DECL.Name = id; attributes->DECL_LIST.Elem->INTENT_DECL.Pos = pos;
  2099.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2100.  
  2101. # line 1512 "MakeDefs.puma"
  2102.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2103.   }
  2104.    return;
  2105.  
  2106.   case kOPTIONAL_DECL:
  2107. # line 1515 "MakeDefs.puma"
  2108.   {
  2109. # line 1516 "MakeDefs.puma"
  2110.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->OPTIONAL_DECL.Name = id; attributes->DECL_LIST.Elem->OPTIONAL_DECL.Pos = pos;
  2111.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2112.  
  2113. # line 1519 "MakeDefs.puma"
  2114.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2115.   }
  2116.    return;
  2117.  
  2118.   case kPOINTER_DECL:
  2119. # line 1522 "MakeDefs.puma"
  2120.   {
  2121. # line 1523 "MakeDefs.puma"
  2122.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->POINTER_DECL.Name = id; attributes->DECL_LIST.Elem->POINTER_DECL.Pos = pos;
  2123.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2124.  
  2125. # line 1526 "MakeDefs.puma"
  2126.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2127.   }
  2128.    return;
  2129.  
  2130.   case kTARGET_DECL:
  2131. # line 1529 "MakeDefs.puma"
  2132.   {
  2133. # line 1530 "MakeDefs.puma"
  2134.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->TARGET_DECL.Name = id; attributes->DECL_LIST.Elem->TARGET_DECL.Pos = pos;
  2135.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2136.  
  2137. # line 1533 "MakeDefs.puma"
  2138.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2139.   }
  2140.    return;
  2141.  
  2142.   case kPUBLIC_DECL:
  2143. # line 1536 "MakeDefs.puma"
  2144.   {
  2145. # line 1537 "MakeDefs.puma"
  2146.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->PUBLIC_DECL.Name = id; attributes->DECL_LIST.Elem->PUBLIC_DECL.Pos = pos;
  2147.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2148.  
  2149. # line 1540 "MakeDefs.puma"
  2150.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2151.   }
  2152.    return;
  2153.  
  2154.   case kPRIVATE_DECL:
  2155. # line 1543 "MakeDefs.puma"
  2156.   {
  2157. # line 1544 "MakeDefs.puma"
  2158.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->PRIVATE_DECL.Name = id; attributes->DECL_LIST.Elem->PRIVATE_DECL.Pos = pos;
  2159.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2160.  
  2161. # line 1547 "MakeDefs.puma"
  2162.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2163.   }
  2164.    return;
  2165.  
  2166.   case kPARAMETER_DECL:
  2167. # line 1550 "MakeDefs.puma"
  2168.   {
  2169. # line 1551 "MakeDefs.puma"
  2170.  IsParameterEntity = true;
  2171. # line 1552 "MakeDefs.puma"
  2172.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2173.   }
  2174.    return;
  2175.  
  2176.   case kTEMPLATE_DECL:
  2177. # line 1555 "MakeDefs.puma"
  2178.   {
  2179. # line 1556 "MakeDefs.puma"
  2180.  if (Entity == NoTree)
  2181.       { Entity = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->TEMPLATE_DECL.Name = id; attributes->DECL_LIST.Elem->TEMPLATE_DECL.Pos = pos; }
  2182.      else
  2183.       tree_error_protocol ("Illegal TEMPLATE", current_entity);
  2184.  
  2185. # line 1561 "MakeDefs.puma"
  2186.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2187.   }
  2188.    return;
  2189.  
  2190.   case kPROCESSORS_DECL:
  2191. # line 1564 "MakeDefs.puma"
  2192.   {
  2193. # line 1565 "MakeDefs.puma"
  2194.  if (Entity == NoTree)
  2195.       { Entity = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->PROCESSORS_DECL.Name = id; attributes->DECL_LIST.Elem->PROCESSORS_DECL.Pos = pos; }
  2196.      else
  2197.       tree_error_protocol ("Illegal PROCESSORS", current_entity);
  2198.  
  2199. # line 1570 "MakeDefs.puma"
  2200.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2201.   }
  2202.    return;
  2203.  
  2204.   case kALIGN_DECL:
  2205. # line 1573 "MakeDefs.puma"
  2206.   {
  2207. # line 1574 "MakeDefs.puma"
  2208.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->ALIGN_DECL.Name = id; attributes->DECL_LIST.Elem->ALIGN_DECL.Pos = pos;
  2209.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2210.  
  2211. # line 1577 "MakeDefs.puma"
  2212.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2213.   }
  2214.    return;
  2215.  
  2216.   case kDYNAMIC_DECL:
  2217. # line 1580 "MakeDefs.puma"
  2218.   {
  2219. # line 1581 "MakeDefs.puma"
  2220.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->DYNAMIC_DECL.Name = id; attributes->DECL_LIST.Elem->DYNAMIC_DECL.Pos = pos;
  2221.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2222.  
  2223. # line 1584 "MakeDefs.puma"
  2224.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2225.   }
  2226.    return;
  2227.  
  2228.   case kDISTRIBUTE_DECL:
  2229. # line 1587 "MakeDefs.puma"
  2230.   {
  2231. # line 1588 "MakeDefs.puma"
  2232.   newdecl = attributes->DECL_LIST.Elem; attributes->DECL_LIST.Elem->DISTRIBUTE_DECL.Name = id; attributes->DECL_LIST.Elem->DISTRIBUTE_DECL.Pos = pos;
  2233.      NewEntityDecls = mDECL_LIST (newdecl, NewEntityDecls);
  2234.  
  2235. # line 1591 "MakeDefs.puma"
  2236.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2237.   }
  2238.    return;
  2239.  
  2240.   }
  2241.  
  2242. # line 1594 "MakeDefs.puma"
  2243.   {
  2244. # line 1595 "MakeDefs.puma"
  2245.    tree_error_protocol ("Unknown Attribute", attributes->DECL_LIST.Elem);
  2246. # line 1596 "MakeDefs.puma"
  2247.    TranslateEntityDecl (id, pos, attributes->DECL_LIST.Next, current_entity);
  2248.   }
  2249.    return;
  2250.  
  2251.   }
  2252. ;
  2253. }
  2254.  
  2255. static void UpdateEntityVal
  2256. # if defined __STDC__ | defined __cplusplus
  2257. (register tTree decl, register tTree newval)
  2258. # else
  2259. (decl, newval)
  2260.  register tTree decl;
  2261.  register tTree newval;
  2262. # endif
  2263. {
  2264.   if (decl == NoTree) return;
  2265.   if (newval == NoTree) return;
  2266.   if (decl->Kind == kVAR_DECL) {
  2267.   if (decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  2268. # line 1601 "MakeDefs.puma"
  2269.   {
  2270. # line 1602 "MakeDefs.puma"
  2271.  decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_COMP_TYPE = newval;
  2272.   }
  2273.    return;
  2274.  
  2275.   }
  2276. # line 1605 "MakeDefs.puma"
  2277.   {
  2278. # line 1606 "MakeDefs.puma"
  2279.  decl->VAR_DECL.VAL = newval;
  2280.   }
  2281.    return;
  2282.  
  2283.   }
  2284. ;
  2285. }
  2286.  
  2287. static void UpdateEntityDims
  2288. # if defined __STDC__ | defined __cplusplus
  2289. (register tTree decl, register tTree newdims)
  2290. # else
  2291. (decl, newdims)
  2292.  register tTree decl;
  2293.  register tTree newdims;
  2294. # endif
  2295. {
  2296.   if (decl == NoTree) return;
  2297.   if (newdims == NoTree) return;
  2298.   if (decl->Kind == kVAR_DECL) {
  2299.   if (decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  2300. # line 1611 "MakeDefs.puma"
  2301.   {
  2302. # line 1612 "MakeDefs.puma"
  2303.  decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES = newdims;
  2304.   }
  2305.    return;
  2306.  
  2307.   }
  2308. # line 1615 "MakeDefs.puma"
  2309.   {
  2310. # line 1616 "MakeDefs.puma"
  2311.  decl->VAR_DECL.VAL = mARRAY_TYPE (newdims, decl->VAR_DECL.VAL);
  2312.   }
  2313.    return;
  2314.  
  2315.   }
  2316.   if (decl->Kind == kTEMPLATE_DECL) {
  2317. # line 1619 "MakeDefs.puma"
  2318.   {
  2319. # line 1620 "MakeDefs.puma"
  2320.  decl->TEMPLATE_DECL.DIMENSIONS = newdims;
  2321.   }
  2322.    return;
  2323.  
  2324.   }
  2325.   if (decl->Kind == kPROCESSORS_DECL) {
  2326. # line 1623 "MakeDefs.puma"
  2327.   {
  2328. # line 1624 "MakeDefs.puma"
  2329.  decl->PROCESSORS_DECL.DIMENSIONS = newdims;
  2330.   }
  2331.    return;
  2332.  
  2333.   }
  2334. ;
  2335. }
  2336.  
  2337. static tTree Normal2DECLDefs
  2338. # if defined __STDC__ | defined __cplusplus
  2339. (register tTree t)
  2340. # else
  2341. (t)
  2342.  register tTree t;
  2343. # endif
  2344. {
  2345. # line 1644 "MakeDefs.puma"
  2346.  
  2347. tTree newdecl;
  2348.  
  2349.   if (t->Kind == kDECL_LIST) {
  2350. # line 1648 "MakeDefs.puma"
  2351.   {
  2352. # line 1649 "MakeDefs.puma"
  2353.  newdecl = Normal2DECLDefs (t->DECL_LIST.Elem);
  2354.      t->DECL_LIST.Next    = Normal2DECLDefs (t->DECL_LIST.Next);
  2355.      newdecl = ReplaceDECL (t, newdecl, t->DECL_LIST.Next);
  2356.  
  2357.   }
  2358.    return newdecl;
  2359.  
  2360.   }
  2361.   if (t->Kind == kDECL_EMPTY) {
  2362. # line 1656 "MakeDefs.puma"
  2363.    return t;
  2364.  
  2365.   }
  2366.   if (t->Kind == kDIMENSION_DECL) {
  2367. # line 1660 "MakeDefs.puma"
  2368.  {
  2369.   tTree type;
  2370.   tDefinitions obj;
  2371.   {
  2372. # line 1664 "MakeDefs.puma"
  2373.  
  2374. # line 1665 "MakeDefs.puma"
  2375.  
  2376. # line 1667 "MakeDefs.puma"
  2377.  obj = GetLocalDecl (t->DIMENSION_DECL.Name);
  2378.       if (obj == NoObject)
  2379.          type = mDUMMY_TYPE ();
  2380.        else
  2381.          type = VarType (obj);
  2382.       type = mARRAY_TYPE (t->DIMENSION_DECL.INDEXES, type);
  2383.       t->Kind = kVAR_DECL;
  2384.       t->VAR_DECL.VAL = type;
  2385.  
  2386.   }
  2387.   {
  2388.    return t;
  2389.   }
  2390.  }
  2391.  
  2392.   }
  2393.   if (t->Kind == kVAR_DECL) {
  2394.   if (t->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  2395. # line 1679 "MakeDefs.puma"
  2396.    return t;
  2397.  
  2398.   }
  2399. # line 1686 "MakeDefs.puma"
  2400.  {
  2401.   tTree newdecl;
  2402.   tDefinitions obj;
  2403.   int rank;
  2404.   {
  2405. # line 1690 "MakeDefs.puma"
  2406.  
  2407. # line 1691 "MakeDefs.puma"
  2408.  
  2409. # line 1692 "MakeDefs.puma"
  2410.  
  2411. # line 1694 "MakeDefs.puma"
  2412.  obj = GetLocalDecl (t->VAR_DECL.Name);
  2413.       if (obj != NoObject)
  2414.          rank = VarRank (obj);
  2415.         else
  2416.          rank = 0;
  2417.       if (rank == 0)
  2418.          newdecl = t;
  2419.        else
  2420.          newdecl = NoTree;
  2421.  
  2422.   }
  2423.   {
  2424.    return newdecl;
  2425.   }
  2426.  }
  2427.  
  2428.   }
  2429. # line 1709 "MakeDefs.puma"
  2430.    return t;
  2431.  
  2432. }
  2433.  
  2434. void BeginMakeDefs ()
  2435. {
  2436. }
  2437.  
  2438. void CloseMakeDefs ()
  2439. {
  2440. }
  2441.